home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / PowerMacOberon feb96 / Source / BalloonElems.Mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1996-01-19  |  14.5 KB  |  403 lines  |  [TEXT/.Ob4]
  1. Syntax10.Scn.Fnt
  2. StampElems
  3. Alloc
  4. 19 Jan 96
  5. Syntax10b.Scn.Fnt
  6. Syntax10i.Scn.Fnt
  7. MarkElems
  8. Alloc
  9. MODULE BalloonElems; (* HM 13 Oct 94 / 
  10. (*------------------------------------------------------------------------------------
  11. Automatically installs a TextFrame handler that intercepts MM+MR clicks and shows a popup text
  12. with an explanation of the word that was clicked at.
  13. The module also provides Balloon elements containing a dictionary of words and their explanation.
  14.     Dictionary = {Word Explanation}.
  15.     Word = string.
  16.     Explanation = <any text not containing a quote>.
  17. ------------------------------------------------------------------------------------*)
  18. IMPORT Display, Input, Files, Viewers, Texts, TextFrames, Oberon, PopupElems, HandlerElems, Bitmaps;
  19. CONST
  20.     left =2; middle = 1; right = 0;
  21.     cancel = {left, middle, right};
  22.     pixel = LONG(10000);
  23.     CR = 0DX;
  24.     grey2 = 13;
  25.     Elem* = POINTER TO ElemDesc;
  26.     ElemDesc* = RECORD (PopupElems.ElemDesc) END;
  27.     Node = POINTER TO NodeDesc;
  28.     NodeDesc = RECORD
  29.         key: ARRAY 32 OF CHAR;
  30.         pos: LONGINT;
  31.         left, right: Node
  32.     END;
  33.     icon: Display.Pattern;
  34.     SuperHandle: Display.Handler;
  35.     stdDict: Texts.Text;  (*search a name in this dictionary if it is not found in any local dictionary*)
  36.     tree: Node;    (*standard directory tree*)
  37.     w: Texts.Writer;
  38. (*----- Balloon Elements -----*)
  39. PROCEDURE 
  40. Handle* (e: Texts.Elem; VAR m: Texts.ElemMsg);
  41.     VAR e1: Elem; buf: Texts.Buffer; f: TextFrames.Frame; v, v0: Viewers.Viewer; x, y: INTEGER;
  42. BEGIN
  43.     WITH e: Elem DO
  44.         WITH m: Texts.CopyMsg DO
  45.             IF m.e = NIL THEN NEW(e1); m.e := e1 END;
  46.             PopupElems.Handle(e, m)
  47.         | m: Texts.IdentifyMsg DO
  48.             m.mod := "BalloonElems"; m.proc := "Alloc"
  49.         | m: TextFrames.DisplayMsg DO
  50.             IF m.prepare THEN
  51.                 e.W := 13 * pixel; e.H := LONG(TextFrames.menuH-1) * pixel;
  52.             ELSE e.name := ""; PopupElems.Handle(e, m);
  53.                 Display.CopyPattern(Display.white, icon, m.X0+2, m.Y0+2, Display.paint)
  54.             END
  55.         | m: TextFrames.TrackMsg DO
  56.             IF m.keys = {middle} THEN
  57.                 Texts.Delete(e.menu, 0, e.menu.len); (*save it in recall buffer*)
  58.                 Texts.Write(w, " "); Texts.Append(e.menu, w.buf); PopupElems.MeasureMenu(e);
  59.                 Oberon.AllocateUserViewer(Oberon.Mouse.X, x, y);
  60.                 v0 := Viewers.This(x, y-1); PopupElems.Handle(e, m); v := Viewers.This(x, y-1);
  61.                 Texts.Recall(buf);
  62.                 IF v # v0 THEN (*v is the edit viewer*)
  63.                     f := v.dsc.next(TextFrames.Frame);
  64.                     Texts.Delete(f.text, 0, 1); Texts.Append(f.text, buf); Texts.Save(f.text, 0, f.text.len, buf)
  65.                 END;
  66.                 Texts.Delete(e.menu, 0, 1); Texts.Append(e.menu, buf);
  67.                 m.keys := {}
  68.             END
  69.         ELSE PopupElems.Handle(e, m)
  70.         END
  71. END Handle;
  72. PROCEDURE 
  73. Alloc*;
  74.     VAR e: Elem;
  75. BEGIN
  76.     NEW(e); e.handle := Handle; Texts.new := e
  77. END Alloc;
  78. PROCEDURE 
  79. Insert*;
  80.     VAR e: Elem; insert: TextFrames.InsertElemMsg;
  81. BEGIN
  82.     NEW(e); e.handle := Handle; e.name := ""; e.small := TRUE;
  83.     e.menu := TextFrames.Text(""); PopupElems.MeasureMenu(e);
  84.     insert.e := e; Viewers.Broadcast(insert)
  85. END Insert;
  86. (*----- Binary Tree -----*)
  87. PROCEDURE 
  88. Add (key: ARRAY OF CHAR; pos: LONGINT);
  89.     VAR p, q, father: Node;
  90. BEGIN
  91.     p := tree.right; father := tree;
  92.     WHILE p # NIL DO
  93.         father := p;
  94.         IF key < p.key THEN p := p.left ELSE p := p.right END
  95.     END;
  96.     NEW(q); COPY(key, q.key); q.pos := pos;
  97.     IF key < father.key THEN father.left := q ELSE father.right := q END
  98. END Add;
  99. PROCEDURE 
  100. Balance;  (*CACM Sept.86, pp. 902*)
  101.     VAR p, tail, rest: Node; size, n, i: INTEGER;
  102.     PROCEDURE Compress (root: Node; n: INTEGER);
  103.         VAR p, son: Node; i: INTEGER;
  104.     BEGIN
  105.         p := root;
  106.         FOR i := 1 TO n DO
  107.             son := p.right; p.right := son.right; p := p.right;
  108.             son.right := p.left; p.left := son
  109.         END
  110.     END Compress;
  111. BEGIN
  112.     (*--- make vine ---*)
  113.     tail := tree; rest := tail.right;
  114.     size := 0;
  115.     WHILE rest # NIL DO
  116.         IF rest.left = NIL THEN (*move tail down one*)
  117.             tail := rest; rest := rest.right; INC(size)
  118.         ELSE (*rotate*)
  119.             p := rest.left; rest.left := p.right; p.right := rest; rest := p;
  120.             tail.right := p
  121.         END
  122.     END;
  123.     (*--- make tree ---*)
  124.     i := 1; WHILE i <= size+1 DO i := i + i END;
  125.     n := i DIV 2 - 1;
  126.     Compress(tree, size - n);
  127.     WHILE n > 1 DO
  128.         n := n DIV 2; Compress(tree, n)
  129. END Balance;
  130. (*----- Name Lookup -----*)
  131. PROCEDURE 
  132. InvertRect (f: TextFrames.Frame; x, y, w, h: INTEGER);    (*clips to right and bottom frame margin*)
  133. BEGIN
  134.     IF x + w > f.X + f.W - f.right THEN w := f.X + f.W - f.right - x END;
  135.     IF y >= f.Y + f.bot THEN Display.ReplConst(Display.white, x, y, w, h, Display.invert) END
  136. END InvertRect;
  137. PROCEDURE 
  138. TrackMouse (VAR x, y: INTEGER; VAR keys, keysum: SET);
  139. BEGIN
  140.     Input.Mouse(keys, x, y); keysum := keysum + keys;
  141.     Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, x, y)
  142. END TrackMouse;
  143. PROCEDURE 
  144. CanBeWord (f: Display.Frame; x, y: INTEGER): BOOLEAN;
  145.     VAR tf: TextFrames.Frame; r: Texts.Reader; ch: CHAR;
  146. BEGIN
  147.     tf := f(TextFrames.Frame);
  148.     Texts.OpenReader(r, tf.text, TextFrames.Pos(tf, x, y)); Texts.Read(r, ch);
  149.     RETURN (r.elem = NIL) & (x > tf.X + tf.barW)
  150. END CanBeWord;
  151. PROCEDURE 
  152. GetDict (t: Texts.Text; VAR dict: Texts.Text);
  153.     VAR r: Texts.Reader;
  154. BEGIN
  155.     Texts.OpenReader(r, t, 0); Texts.ReadElem(r);
  156.     WHILE (r.elem # NIL) &  ~ (r.elem IS Elem) DO Texts.ReadElem(r) END;
  157.     IF r.elem # NIL THEN dict := r.elem(Elem).menu ELSE dict := NIL END
  158. END GetDict;
  159. PROCEDURE 
  160. WordBeg (t: Texts.Text; pos: LONGINT): LONGINT;
  161.     VAR r: Texts.Reader; ch: CHAR; pos0: LONGINT;
  162. BEGIN
  163.     pos0 := pos; Texts.OpenReader(r, t, pos); Texts.Read(r, ch);
  164.     WHILE (CAP(ch) >= "A") & (CAP(ch) <= "Z") OR (ch >= "0") & (ch <= "9") OR (ch = ".") DO
  165.         DEC(pos); IF pos < 0 THEN RETURN 0 END;
  166.         Texts.OpenReader(r, t, pos); Texts.Read(r, ch)
  167.     END;
  168.     IF pos < pos0 THEN INC(pos) END;
  169.     RETURN pos
  170. END WordBeg;
  171. PROCEDURE 
  172. WordEnd (t: Texts.Text; pos: LONGINT): LONGINT;
  173.     VAR r: Texts.Reader; ch: CHAR; pos0: LONGINT;
  174. BEGIN
  175.     pos0 := pos; Texts.OpenReader(r, t, pos); Texts.Read(r, ch);
  176.     WHILE (CAP(ch) >= "A") & (CAP(ch) <= "Z") OR (ch >= "0") & (ch <= "9") OR (ch = ".") DO
  177.         INC(pos); Texts.Read(r, ch)
  178.     END;
  179.     IF pos = pos0 THEN INC(pos) END;
  180.     RETURN pos
  181. END WordEnd;
  182. PROCEDURE 
  183. GetName (ft: Texts.Text; pos: LONGINT; VAR name, fullName: ARRAY OF CHAR; VAR t: Texts.Text);
  184.     VAR r: Texts.Reader; ch: CHAR; beg, end: LONGINT; i, j: INTEGER; imported: BOOLEAN;
  185.         t0: Texts.Text; mod: ARRAY 32 OF CHAR;
  186. BEGIN
  187.     (*--- read name*)
  188.     beg := WordBeg(ft, pos); end:= WordEnd(ft, pos);
  189.     i := 0; Texts.OpenReader(r, ft, beg); imported := FALSE;
  190.     WHILE beg < end DO
  191.         Texts.Read(r, ch); name[i] := ch; INC(i); INC(beg);
  192.         IF ch = "." THEN imported := TRUE END
  193.     END;
  194.     name[i] := 0X; COPY(name, fullName);
  195.     (*--- resolve import if necessary*)
  196.     t := ft;
  197.     IF imported THEN
  198.         i := 0; WHILE name[i] # "." DO mod[i] := name[i]; INC(i) END;
  199.         mod[i] := "."; mod[i+1] := "M"; mod[i+2] := "o"; mod[i+3] := "d"; mod[i+4] := 0X;
  200.         NEW(t0); Texts.Open(t0, mod);
  201.         IF t0.len > 0 THEN
  202.             t := t0; j := 0;
  203.             REPEAT INC(i); name[j] := name[i]; INC(j) UNTIL name[i] = 0X
  204.         END
  205. END GetName;
  206. PROCEDURE 
  207. PrefixName (VAR name: ARRAY OF CHAR; f: TextFrames.Frame);
  208.     VAR v: Viewers.Viewer; s: Texts.Scanner; i, j: INTEGER; nm: ARRAY 64 OF CHAR;
  209. BEGIN
  210.     v := Viewers.This(f.X, f.Y);
  211.     Texts.OpenScanner(s, v.dsc(TextFrames.Frame).text, 0); Texts.Scan(s);
  212.     COPY(s.s, nm); i := s.len-1;
  213.     WHILE (i >= 0) & (nm[i] # ".") DO DEC(i) END;
  214.     INC(i); j := 0;
  215.     WHILE (i < 63) & (name[j] # 0X) DO nm[i] := name[j]; INC(i); INC(j) END;
  216.     nm[i] := 0X; COPY(nm, name)
  217. END PrefixName;
  218. PROCEDURE 
  219. MeasureLine (VAR r: Texts.Reader; VAR lw, lh, dsr: INTEGER);
  220.     VAR ch: CHAR; x, y, w, h, dx: INTEGER; p: Display.Pattern;
  221. BEGIN
  222.     Texts.Read(r, ch); lw := 0; lh := 0; dsr := 0;
  223.     WHILE ~r.eot & (ch # CR) DO
  224.         IF r.elem # NIL THEN
  225.             h := SHORT(r.elem.H DIV pixel); dx := SHORT(r.elem.W DIV pixel); y := r.fnt.minY
  226.         ELSE
  227.             Display.GetChar(r.fnt.raster, ch, dx, x, y, w, h, p); INC(y, r.fnt.height * r.voff DIV 64);
  228.         END;
  229.         IF y < dsr THEN dsr := y END;
  230.         IF y + h > lh THEN lh := y + h END;
  231.         INC(lw, dx);
  232.         Texts.Read(r, ch)
  233.     END;
  234.     dsr := -dsr; lh := lh + dsr;
  235.     IF (ch = CR) & (lh = 0) THEN lh := 10; dsr := 0; lw := 8 END
  236. END MeasureLine;
  237. PROCEDURE 
  238. Popup* (t: Texts.Text; beg, end: LONGINT);
  239.     VAR r: Texts.Reader; ch: CHAR; x, y, w, h, dx, bx, by, bw, bh, lw, i, X, Y: INTEGER; b: Bitmaps.Bitmap; p: Display.Pattern;
  240.         lh, dsr: ARRAY 128 OF INTEGER; e: Texts.Elem; dsp: TextFrames.DisplayMsg; keys: SET;
  241. BEGIN
  242.     (*--- measure text*)
  243.     Input.Mouse(keys, x, y);
  244.     bw := 0; bh := 0;
  245.     Texts.OpenReader(r, t, beg); i := 0;
  246.     WHILE Texts.Pos(r) < end DO
  247.         MeasureLine(r, lw, lh[i], dsr[i]);
  248.         IF lw > bw THEN bw := lw END;
  249.         bh := bh + lh[i]; INC(i)
  250.     END;
  251.     INC(bw, 8); IF bw > Display.Width THEN bw := Display.Width END;
  252.     INC(bh, 8); IF bh > Display.Height THEN bh := Display.Height END;
  253.     bx := x; IF bx + bw > Display.Width THEN bx := Display.Width - bw END;
  254.     by := y + 10; IF by + bh > Display.Height THEN by := Display.Height - bh END;
  255.     (*--- show text*)
  256.     b := Bitmaps.New(bw, bh); Bitmaps.CopyBlock(Bitmaps.Disp, b, bx, by, bw, bh, 0, 0, 0);
  257.     Display.ReplConst(Display.white, bx, by, bw, bh, Display.replace);
  258.     Display.ReplConst(grey2, bx+1, by+1, bw-2, bh-2, Display.replace);
  259.     X := bx + 4; Y := by + bh - 4 - lh[0] + dsr[0];
  260.     Texts.OpenReader(r, t, beg); i := 0;
  261.     WHILE beg < end DO
  262.         Texts.Read(r, ch); INC(beg);
  263.         IF ch = CR THEN
  264.             INC(i); X := bx + 4; Y := Y - dsr[i-1] - lh[i] + dsr[i]
  265.         ELSIF r.elem # NIL THEN
  266.             e := r.elem; y := r.fnt.minY;
  267.             dsp.prepare := FALSE; dsp.fnt := r.fnt; dsp.col := r.col; dsp.pos := beg - 1;
  268.             dsp.frame := NIL; dsp.X0 := X; dsp.Y0 := Y+y; dsp.elemFrame := NIL;
  269.             e.handle(e, dsp); INC(X, SHORT(e.W DIV pixel))
  270.         ELSE
  271.             Display.GetChar(r.fnt.raster, ch, dx, x, y, w, h, p); INC(y, r.fnt.height * r.voff DIV 64);
  272.             Display.CopyPattern(Display.white, p, X+x, Y+y, Display.paint); X := X + dx
  273.         END
  274.     END;
  275.     (*--- wait until right mouse button is released*)
  276.     REPEAT Input.Mouse(keys, x, y) UNTIL ~(right IN keys);
  277.     Bitmaps.CopyBlock(b, Bitmaps.Disp, 0, 0, bw, bh, bx, by, 0)
  278. END Popup;
  279. PROCEDURE 
  280. GetBounds (VAR s: Texts.Scanner; t: Texts.Text; VAR beg, end: LONGINT);
  281.     VAR ch: CHAR;
  282. BEGIN
  283.     IF ~s.eot THEN beg := Texts.Pos(s); Texts.Read(s, ch);
  284.         WHILE ~s.eot & (ch <= " ") & (ch # Texts.ElemChar) DO INC(beg); Texts.Read(s, ch) END;
  285.         end := beg;
  286.         WHILE ~s.eot & (ch # '"') DO INC(end); Texts.Read(s, ch) END;
  287.         REPEAT DEC(end); Texts.OpenReader(s, t, end); Texts.Read(s, ch) UNTIL (ch > " ") OR (ch = Texts.ElemChar);
  288.         INC(end);
  289.         IF beg >= end THEN beg := -1 END
  290.     ELSE beg := -1
  291. END GetBounds;
  292. PROCEDURE 
  293. Show (nm: ARRAY OF CHAR; dict: Texts.Text; VAR done: BOOLEAN);
  294.     VAR s: Texts.Scanner; name: ARRAY 64 OF CHAR; beg, end: LONGINT;
  295. BEGIN
  296.     COPY(nm, name); (*circumvent compiler bug*)
  297.     Texts.OpenScanner(s, dict, 0);
  298.     REPEAT Texts.Scan(s) UNTIL s.eot OR (s.class = Texts.String) & (s.s = name);
  299.     GetBounds(s, dict, beg, end);
  300.     IF beg >= 0 THEN Popup(dict, beg, end) END;
  301.     done := beg >= 0
  302. END Show;
  303. PROCEDURE 
  304. ShowStd (name: ARRAY OF CHAR; VAR done: BOOLEAN);
  305.     VAR p: Node; s: Texts.Scanner; beg, end: LONGINT;
  306. BEGIN
  307.     p := tree.right;
  308.     WHILE (p # NIL) & (p.key # name) DO
  309.         IF name < p.key THEN p := p.left ELSE p := p.right END
  310.     END;
  311.     IF p # NIL THEN
  312.         Texts.OpenScanner(s, stdDict, p.pos);
  313.         GetBounds(s, stdDict, beg, end);
  314.         Popup(stdDict, beg, end)
  315.     END;
  316.     done := p # NIL
  317. END ShowStd;
  318. PROCEDURE 
  319. TrackWord (f: TextFrames.Frame; VAR m: Oberon.InputMsg) : BOOLEAN;
  320.     VAR keys: SET; new, old: TextFrames.Location; dict, t: Texts.Text; name, fullName: ARRAY 64 OF CHAR;
  321.         x, y: INTEGER; done: BOOLEAN;
  322. BEGIN
  323.     TextFrames.LocateWord(f, x, y, old); InvertRect(f, old.x, old.y, old.dx, 2);
  324.     m.keys := {};
  325.     TrackMouse(x, y, keys, m.keys);
  326.     WHILE (keys # {}) & ~(left IN keys) & (m.keys # cancel) DO
  327.         TextFrames.LocateWord(f, x, y, new);
  328.         IF new.pos # old.pos THEN
  329.             InvertRect(f, old.x, old.y, old.dx, 2); InvertRect(f, new.x, new.y, new.dx, 2); old := new
  330.         END;
  331.         IF keys = {middle, right} THEN
  332.             GetName(f.text, TextFrames.Pos(f, x, y), name, fullName, t);
  333.             GetDict(t, dict);
  334.             done := FALSE;
  335.             IF dict # NIL THEN Show(name, dict, done) END;
  336.             IF ~done THEN ShowStd(fullName, done) END;
  337.             IF ~done THEN
  338.                 PrefixName(fullName, f);
  339.                 ShowStd(fullName, done)
  340.             END;
  341.             m.keys := cancel
  342.         END;
  343.         TrackMouse(x, y, keys, m.keys)
  344.     END;
  345.     InvertRect(f, old.x, old.y, old.dx, 2);
  346.     IF m.keys # cancel THEN EXCL (m.keys, left) END;
  347.     RETURN done
  348. END TrackWord;
  349. PROCEDURE 
  350. FrameHandler* (f: Display.Frame; VAR m: Display.FrameMsg);
  351.     VAR showed: BOOLEAN; open: Oberon.InputMsg;
  352. BEGIN
  353.     WITH f: TextFrames.Frame DO
  354.         WITH m: Oberon.InputMsg DO
  355.             IF (m.id = Oberon.track) & (middle IN m.keys) & CanBeWord(f, m.X, m.Y) THEN
  356.                 showed := TrackWord(f(TextFrames.Frame), m);
  357.                 IF ~showed THEN
  358.                     open.id := Oberon.track; open.keys := {middle}; open.X := m.X; open.Y := m.Y;
  359.                     SuperHandle(f, open)
  360.                 ELSIF m.keys # cancel THEN SuperHandle(f, m)
  361.                 END
  362.             ELSE SuperHandle(f, m)
  363.             END
  364.         ELSE SuperHandle(f, m)
  365.         END
  366. END FrameHandler;
  367. PROCEDURE 
  368. LoadDictionary*;
  369.     VAR s: Texts.Scanner;
  370. BEGIN
  371.     NEW(tree); tree.key := "";
  372.     IF Files.Old("Balloon.Text") # NIL THEN
  373.         NEW(stdDict); Texts.Open(stdDict, "Balloon.Text");
  374.         Texts.OpenScanner(s, stdDict, 0); Texts.Scan(s);
  375.         WHILE ~s.eot DO
  376.             IF s.class = Texts.String THEN Add(s.s, Texts.Pos(s)) END;
  377.             Texts.Scan(s)
  378.         END;
  379.         Balance
  380. END LoadDictionary;
  381. PROCEDURE Install*;    (*loads the module, installs the handler, and reads the dictionary*)
  382. END Install;
  383. PROCEDURE 
  384. InitIcon;
  385.     VAR line: ARRAY 9 OF SET;
  386. BEGIN
  387.     line[8] := {};
  388.     line[7] := {1..6};
  389.     line[6] := {0, 7};
  390.     line[5] := {0, 7};
  391.     line[4] := {0, 7};
  392.     line[3] := {1..4, 6};
  393.     line[2] := {5, 6};
  394.     line[1] := {6, 7};
  395.     icon := Display.NewPattern(line, 8, 8);
  396. END InitIcon;
  397. BEGIN
  398.     InitIcon;
  399.     HandlerElems.SetHandler("BalloonElems.FrameHandler", FrameHandler, SuperHandle);
  400.     LoadDictionary;
  401.     Texts.OpenWriter(w)
  402. END BalloonElems.
  403.